home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / GETCOLOR.PRG < prev    next >
Text File  |  1993-05-04  |  3KB  |  111 lines
  1. *' $Header: $
  2. FUNCTION GetColor
  3. PARAMETERS pn_display
  4. *----------------------------------------------------------------------------
  5. * NAME
  6. *   GetColor() - 
  7. *
  8. * SYNOPSIS
  9. *   GetColor( pn_display )
  10. *
  11. * DESCRIPTION
  12. *
  13. * PARAMETERS
  14. *   pn_display = Numeric value representing the color of an object
  15. *
  16. *----------------------------------------------------------------------------
  17.   Foreground  =   7
  18.   Intensity   =   8                     && Color attributes
  19.   Background  = 112
  20.   MIntensity  = 256
  21.   Reverse     = 512                     && Mono attributes
  22.   Underline   =1024
  23.   Blink       =2048
  24.   default     =32768                    && Screen set to default
  25.  
  26.   incolor     = ""
  27.  
  28.   use_colors  = BitWAnd( default,    pn_display )
  29.   IF use_colors = 0
  30.  
  31.     forgrnd     = BitWAnd( Foreground, pn_display )
  32.     enhanced    = BitWAnd( Intensity,  pn_display ) > 0 .OR. ;
  33.                   BitWAnd( MIntensity, pn_display ) > 0
  34.     backgrnd    = BitWAnd( Background, pn_display )
  35.     blnk        = BitWAnd( Blink,      pn_display )
  36.     underln     = BitWAnd( Underline,  pn_display )
  37.     revrse      = BitWAnd( Reverse,    pn_display )
  38.  
  39.     backgrnd = IIF( backgrnd > 0, INT( backgrnd / 16 ), backgrnd )
  40.     IF .NOT. ( "MONO" $ SET( "DISPLAY" ) )
  41.       DO CASE
  42.         CASE forgrnd = 0
  43.           incolor = "n"
  44.         CASE forgrnd = 1
  45.           incolor = "b"
  46.         CASE forgrnd = 2
  47.           incolor = "b"
  48.         CASE forgrnd = 3
  49.           incolor = "bg"
  50.         CASE forgrnd = 4
  51.           incolor = "r"
  52.         CASE forgrnd = 5
  53.           incolor = "rb"
  54.         CASE forgrnd = 6
  55.           incolor = "gr"
  56.         CASE forgrnd = 7
  57.           incolor = "w"
  58.       ENDCASE
  59.     ELSE
  60.       incolor = "w"
  61.     ENDIF
  62.  
  63.     IF revrse > 0
  64.       incolor = incolor + "i"
  65.     ENDIF
  66.  
  67.     IF underln > 0
  68.       incolor = incolor + "u"
  69.     ENDIF
  70.  
  71.     IF enhanced 
  72.       incolor = incolor + "+"
  73.     ENDIF
  74.  
  75.     IF blnk > 0
  76.       incolor = incolor + "*"
  77.     ENDIF
  78.  
  79.     incolor = incolor + "/"
  80.  
  81.     IF .NOT. ( "MONO" $ SET( "DISPLAY" ) )
  82.       DO CASE
  83.         CASE backgrnd = 0
  84.           incolor = incolor + "n"
  85.         CASE backgrnd = 1
  86.           incolor = incolor + "b"
  87.         CASE backgrnd = 2
  88.           incolor = incolor + "b"
  89.         CASE backgrnd = 3
  90.           incolor = incolor + "bg"
  91.         CASE backgrnd = 4
  92.           incolor = incolor + "r"
  93.         CASE backgrnd = 5
  94.           incolor = incolor + "rb"
  95.         CASE backgrnd = 6
  96.           incolor = incolor + "gr"
  97.         CASE backgrnd = 7
  98.           incolor = incolor + "w"
  99.       ENDCASE
  100.     ELSE
  101.       incolor = incolor + "n"
  102.     ENDIF
  103.  
  104.   ENDIF
  105. RETURN( incolor )
  106. *-- EOF: GetColor( pn_display )
  107. *'----------------------------------------------------------------------------
  108. *' $Log: $
  109. *'----------------------------------------------------------------------------
  110.  
  111.